home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MISC.SWG / 0062_RANDOM Numbers.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-26  |  2KB  |  120 lines
  1.  
  2. interface
  3.  
  4. procedure InitRandomGenerator(InitValue : longint);
  5. function Random:real;
  6.  
  7. implementation
  8. type
  9.   Lint = record
  10.            a,b,c,d : word;
  11.          end;
  12. var
  13.   yWertZufall : Lint;
  14.   Modul       : Lint;
  15.   Faktor      : integer;
  16. procedure LintMUL(var p1: Lint; p2: integer);
  17. begin
  18.   asm
  19.          mov cx,4
  20.          les di,p1
  21.          xor bx,bx
  22.          cld
  23.   @mull: mov ax,es:[di]
  24.          mov dx,p2
  25.          mul dx
  26.          add ax,bx
  27.          adc dx,0
  28.          mov bx,dx
  29.          stosw
  30.          loop @mull
  31.   end;
  32. end;
  33. procedure LintSub(var p1, p2: Lint);
  34. var
  35.   result : longint;
  36.   carry : word;
  37. begin
  38.   result := p1.a;
  39.   dec(result, p2.a);
  40.   if result < 0 then
  41.   begin
  42.     carry := 1;
  43.     inc(result, 65536);
  44.   end
  45.   else
  46.     carry := 0;
  47.   p1.a := result;
  48.   result := p1.b;
  49.   dec(result, carry);
  50.   dec(result, p2.b);
  51.   if result < 0 then
  52.   begin
  53.     carry := 1;
  54.     inc(result, 65536);
  55.   end
  56.   else
  57.     carry := 0;
  58.   p1.b := result;
  59.   result := p1.c;
  60.   dec(result, carry);
  61.   dec(result, p2.c);
  62.   if result < 0 then
  63.   begin
  64.     carry := 1;
  65.     inc(result, 65536);
  66.   end
  67.   else
  68.     carry := 0;
  69.   p1.c := result;
  70.   dec(p1.d, carry);
  71.   dec(p1.d, p2.d);
  72. end;
  73.  
  74. procedure InitRandomGenerator(InitValue : longint);
  75. begin
  76.   with yWertZufall do
  77.   begin
  78.     b := InitWert div 65536;
  79.     a := InitWert - b*65536;
  80.     c := 0;
  81.     d := 0;
  82.   end;
  83. end;  (* InitRandomGenerator *)
  84.  
  85. function Random:real;
  86. var
  87.   Wert : longint;
  88. begin
  89.   LintMul(yWertZufall , Faktor);
  90.   if yWertZufall.b >32767 then
  91.     LintSub(yWertZufall,Modul);
  92.  
  93.   Wert := 2*yWertZufall.c + 65536*yWertZufall.b+yWertZufall.a;
  94.   with yWertZufall do  begin
  95.     d := 0;
  96.     c := 0;
  97.     b := Wert shr 16;
  98.     a := Wert - (b*65536);
  99.   end;
  100.   Zufall := Wert / 2147483647;
  101.  
  102. end; (* Zufall *)
  103. begin
  104.   with yWertZufall do
  105.   begin
  106.     a := 0;
  107.     b := 0;
  108.     c := 0;
  109.     d := 0;
  110.   end;
  111.   Faktor := 16807;
  112.   with Modul do
  113.   begin
  114.     a := 65535;
  115.     b := 32767;
  116.     c := 0;
  117.     d := 0;
  118.   end;
  119. end. (* _Zufall *)
  120.